home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
MacHack 1994
/
MacHack 1994.toast
/
MacHack™94
/
Talks & Papers
/
Timothy Knox
/
yerk 3.66
/
Float source
/
fValue
< prev
Wrap
Text File
|
1994-06-24
|
3KB
|
68 lines
\ Fvalue -- support for floating-point analogs of Value and Constant
\ 9/24/85 cbd Version 1.0
\ 11/19/91 rfl change 0 >float to 0. at end to avoid using >float. Then
\ 7.0.1 quickfix works, since don't want to execute any pack4 yet
\ 5/27/92 rfl moved fpmodel stuff to finterpret source; needed finterpret running
\ ========= Code support for Values - CBD 9/85 ======
:CODE flt@ \ fvalue 0cfa code
move.l YERK[(fltNew)],d7
jsr 0(a3,d7.l) ; get new float in d1
lea 12(a3,d6.l),a0 ; get the data addr from WP
lea 2(a3,d1.l),a1
move.l (a0)+,(a1)+ ; copy float data
move.l (a0)+,(a1)+
move.w (a0)+,(a1)+
move.l d1,-(a7) ; return new float
;CODE
:CODE flt++ \ 1cfa code
move.l d6,a2 ; get base address from WP
addq.l #6,a2 ; 2 bytes before data to simulate flt
move.l (a7),d0 ; get parm
move.l a2,(a7) ; put rcvr under parm
move.l d0,-(a7) ; push parm
move.l YERK[(fp1)],d7 ; get subr addr in d7
jsr 0(a3,d7.l) ; go setup stack
clr.w -(A7) ; code for FADD
call pack4
;CODE
:CODE flt! \ 2cfa code
move.l (a7),d0 ; set up for dispose of float
move.l YERK[(fltDisp)],d7
jsr 0(a3,d7.l) ; kill float in D0
lea 4(a3,d6.l),a1 ; base address
move.l (a7)+,d0 ; new value for data
lea 2(a3,d0.l),a0 ;
move.l (a0)+,(a1)+ ; copy float data
move.l (a0)+,(a1)+
move.w (a0)+,(a1)+
;CODE
\ Write a float into dictionary: analogous to , or c, .
( flt -- )
: f, dup 2+ here 10 cmove 10 allot fdrop ;
\ Define Fvalue as an mcfa word
: fValue create -4 allot ' flt@ , ' flt++ , ' flt! , f, ;
\ code for floating point constants
:CODE fcon@ \ fvalue 0cfa code
move.l YERK[(fltNew)],d7
jsr 0(a3,d7.l) ; get new float in d1
lea 4(a3,d6.l),a0 ; get the data addr from WP
lea 2(a3,d1.l),a1
move.l (a0)+,(a1)+ ; copy float data
move.l (a0)+,(a1)+
move.w (a0)+,(a1)+
move.l d1,-(a7) ; return new float
;CODE
: fCon create -4 allot ' fcon@ , f, ;
\ do after installing finterpret
\ 0. fvalue fpmodel
\
\ 'code fpmodel -> fvalcode \ patch value in Args file